home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyGetZoneList.p < prev    next >
Text File  |  1996-06-01  |  2KB  |  100 lines
  1. unit MyGetZoneList;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     function MyGetMyZone: Str255;
  9.     function MyGetZoneList (datap: Ptr; var size: longint; var count: integer): OSErr;
  10.     function MyGetNextZone (var datap: Ptr): Str255;
  11.  
  12. implementation
  13.  
  14.     uses
  15.         Appletalk,Devices;
  16.  
  17.     function MyGetMyZone: Str255;
  18.         var
  19.             xpp: XPPParamBlock;
  20.             oe: OSErr;
  21.             s: Str255;
  22.     begin
  23.         xpp.zipInfoField[1] := 0;
  24.         xpp.zipInfoField[2] := 0;
  25.         xpp.xppTimeOut := 4;
  26.         xpp.xppRetry := 2;
  27.         xpp.zipBuffPtr := @s;
  28.         xpp.ioRefNum := XPPRefNum;        { driver refNum -41 }
  29.         xpp.csCode := xCall;
  30.         xpp.xppSubCode := zipGetMyZone;
  31.         oe := PBControlSync(@xpp);
  32.         if oe <> noErr then
  33.             s := '*';
  34.         MyGetMyZone := s;
  35.     end;
  36.  
  37.     procedure ClearBlock (cb: Ptr; size: longint);
  38.         var
  39.             p: longint;
  40.     begin
  41.         for p := longint(cb) to longint(cb) + size - 1 do
  42.             Ptr(p)^ := -27;
  43.     end;
  44.  
  45.     function MyGetZoneList (datap: Ptr; var size: longint; var count: integer): OSErr;
  46.         var
  47.             xpp: XPPParamBlock;
  48.             oe: OSErr;
  49.             i: integer;
  50.             p: Ptr;
  51.             buffer: packed array[1..578] of Byte;
  52.             b: integer;
  53.             len: integer;
  54.     begin
  55.         ClearBlock(@xpp, sizeof(xpp));
  56.         xpp.ioRefNum := XPPRefNum;        { driver refNum -41 }
  57.         xpp.csCode := xCall;
  58.         xpp.xppSubCode := zipGetZoneList;
  59.         xpp.xppTimeout := 4;
  60.         xpp.xppRetry := 2;
  61.         xpp.zipBuffPtr := @buffer;
  62.         xpp.zipInfoField[1] := 0;
  63.         xpp.zipInfoField[2] := 0;
  64.         count := 0;
  65.         p := datap;
  66.         repeat
  67.             oe := PBControlSync(@xpp);
  68.             if oe = noErr then begin
  69.                 b := 1;
  70.                 for i := 1 to xpp.zipNumZones do begin
  71.                     len := buffer[b] + 1;
  72.                     if size - (ord(p) + len - ord(datap)) > 0 then begin
  73.                         BlockMove(@buffer[b], p, len);
  74.                         p := Ptr(ord(p) + len);
  75.                     end;
  76.                     b := b + len;
  77.                 end;
  78.             end;
  79.             count := count + xpp.zipNumZones;
  80.         until (oe <> noErr) or (xpp.zipLastFlag <> 0);
  81.         size := ord(p) - ord(datap);
  82.         if oe <> noErr then begin
  83.             size := 0;
  84.             count := 0;
  85.         end;
  86.         MyGetZoneList := oe;
  87.     end;
  88.  
  89.     function MyGetNextZone (var datap: Ptr): Str255;
  90.         var
  91.             s: Str255;
  92.             len: integer;
  93.     begin
  94.         len := BAND(datap^, $FF);
  95.         BlockMove(datap, @s, len + 1);
  96.         datap := Ptr(ord(datap) + len + 1);
  97.         MyGetNextZone := s;
  98.     end;
  99.  
  100. end.